home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-01 / ifp1s155.zip / PAGE_08.PAS < prev    next >
Pascal/Delphi Source File  |  1992-04-21  |  8KB  |  328 lines
  1. unit page_08;
  2.  
  3. interface
  4.  
  5. uses crt, ifpglobl, ifpcomon;
  6.  
  7. procedure page08;
  8.  
  9. implementation
  10.  
  11. procedure page08;
  12.   const
  13.     tick2 = 115200;
  14.  
  15.   var
  16.     i : byte;
  17.     xbyte1 : byte;
  18.     xbyte2 : byte;
  19.     xbyte3: byte;
  20.     xbyte4: byte;
  21.     xword : word;
  22.     xword1: word;
  23.     xword2: word;
  24.     temp: word;
  25.     sbport: word;
  26.     sbfound: boolean;
  27.     portok: boolean;
  28.     midifound: boolean;
  29.     soundvect: pointer;
  30.     s: string;
  31.  
  32.   begin
  33.   window(1, 3, 30, tlength - 2);
  34.   caption2('Printers');
  35.   xbyte1:=equip and $C000 shr 14;
  36.   Writeln(xbyte1);
  37.   if xbyte1 > 0 then
  38.     begin
  39.     caption3('Device');
  40.     Writeln;
  41.     caption3('Base Port');
  42.     Writeln;
  43.     caption3('Timeout');
  44.     Writeln;
  45.     caption3('Busy');
  46.     Writeln;
  47.     caption3('ACK');
  48.     Writeln;
  49.     caption3('Paper out');
  50.     Writeln;
  51.     caption3('Selected');
  52.     Writeln;
  53.     caption3('I/O error');
  54.     Writeln;
  55.     caption3('Timed out');
  56.     for i:=1 to xbyte1 do
  57.       begin
  58.       Window(9 + 6 * i, 4, 15 + 6 * i, tlength - 2);
  59.       Writeln('LPT', i);
  60.       Writeln('$', hex(MemW[BIOSdseg : 2 * i + 6], 4));
  61.       Writeln(Mem[BIOSdseg : $0077 + i]);
  62.       with regs do
  63.         begin
  64.         AH:=$02;
  65.         DX:=0;
  66.         Intr($17, regs);
  67.         yesorno(AH and $80 = $00);
  68.         yesorno(AH and $40 = $40);
  69.         yesorno(AH and $20 = $20);
  70.         yesorno(AH and $10 = $10);
  71.         yesorno(AH and $08 = $08);
  72.         yesorno(AH and $01 = $01)
  73.         end
  74.       end
  75.     end;
  76.   Window(twidth - 42, 3, twidth, tlength - 2);
  77.   caption2('Serial ports');
  78.   xbyte1:=equip and $0E00 shr 9;
  79.   Writeln(xbyte1);
  80.   if xbyte1 > 0 then
  81.     begin
  82.     if xbyte1 > 4 then
  83.       xbyte1:=4;
  84.     caption3('Device');
  85.     Writeln;
  86.     caption3('Base port');
  87.     Writeln;
  88.     caption3('UART');
  89.     Writeln;
  90.     caption3('Timeout');
  91.     Writeln;
  92.     caption3('Baud rate');
  93.     Writeln;
  94.     caption3('Data bits');
  95.     Writeln;
  96.     caption3('Parity');
  97.     Writeln;
  98.     caption3('Stop bits');
  99.     Writeln;
  100.     caption3('Break');
  101.     Writeln;
  102.     caption3('RLSD');
  103.     Writeln;
  104.     caption3('RI');
  105.     Writeln;
  106.     caption3('DSR');
  107.     Writeln;
  108.     caption3('CTS');
  109.     Writeln;
  110.     caption3('dRLSD');
  111.     Writeln;
  112.     caption3('-dRI');
  113.     Writeln;
  114.     caption3('dDSR');
  115.     Writeln;
  116.     caption3('dCTS');
  117.     for i:=1 to xbyte1 do
  118.       begin
  119.       window(twidth - 35 + 7 * i, 4, twidth - 28 + 7 * i, tlength - 2);
  120.       Writeln('COM', i);
  121.       xword:=MemW[BIOSdseg : 2 * i - 2];
  122.       if xword = 0 then
  123.         Writeln('N/A')
  124.       else
  125.         begin
  126.         Writeln('$', hex(xword, 4));
  127.         xbyte2:=Port[xword + 2];
  128.         Port[xword + 2]:=$C1;
  129.         xbyte3:=Port[xword + 2];
  130.         Port[xword + 2]:=xbyte2;
  131.         case ((xbyte3 and $C0) shr 6) of
  132.           0: begin
  133.              xbyte2:=Port[xword + 7];
  134.              Port[xword + 7]:=$FA;
  135.              for temp:=1 to 2 do;
  136.              if Port[xword + 7] = $FA then
  137.                begin
  138.                Port[xword + 7]:=$AF;
  139.                for temp:=1 to 2 do;
  140.                if Port[xword + 7] = $AF then
  141.                  begin
  142.                  Port[xword + 7]:=xbyte2;
  143.                  Write('16450')
  144.                  end
  145.                else
  146.                  Write('8250')
  147.                end
  148.              else
  149.                Write('8250')
  150.              end;
  151.           1: Write('???');
  152.           2: Write('16550');
  153.           3: Write('16550A')
  154.         end;
  155.         Writeln;
  156.         Writeln(Mem[BIOSdseg : $007B + i]);
  157.         xbyte2:=Port[xword + 3];
  158.         Port[xword + 3]:=xbyte2 or $80;
  159.         xword2:=cbw(Port[xword], Port[xword + 1]);
  160.         if xword2 = 0 then
  161.           Writeln('N/A')
  162.         else
  163.           Writeln(tick2 / xword2:0:0);
  164.         Port[xword + 3]:=xbyte2;
  165.         Writeln((xbyte2 and $03) + 5);
  166.         case xbyte2 and $38 of
  167.           $00, $10, $20, $30 : Writeln('none');
  168.           $08 : Writeln('odd');
  169.           $18 : Writeln('even');
  170.           $28 : Writeln('mark');
  171.           $38 : Writeln('space')
  172.         end;
  173.         case xbyte2 and $07 of
  174.           $00..$03 : Writeln('1');
  175.           $04 : Writeln('1.5');
  176.           $05..$07 : Writeln('2')
  177.         end;
  178.         yesorno(xbyte2 and $40 = $40);
  179.         with regs do
  180.           begin
  181.           AH:=$03;
  182.           DX:=i - 1;
  183.           Intr($14, regs);
  184.           yesorno(AL and $80 = $80);
  185.           yesorno(AL and $40 = $40);
  186.           yesorno(AL and $20 = $20);
  187.           yesorno(AL and $10 = $10);
  188.           yesorno(AL and $08 = $08);
  189.           yesorno(AL and $04 = $04);
  190.           yesorno(AL and $02 = $02);
  191.           yesorno(AL and $01 = $01)
  192.           end;
  193.         end
  194.       end
  195.     end;
  196.   Window(1, 14, twidth - 43, tlength - 2);
  197.   caption2('Sound cards');
  198.   Writeln;
  199.   caption3('Ad Lib (or compatible)');
  200.   xbyte2:=Port[$388];
  201.   Port[$388]:=$BD;
  202.   xbyte1:=Port[$388];
  203.   xbyte1:=Port[$388];
  204.   xbyte1:=Port[$388];
  205.   xbyte1:=Port[$388];
  206.   xbyte3:=Port[$389];
  207.   Port[$389]:=0;
  208.   for xbyte4:=1 to 36 do
  209.     xbyte1:=Port[$388];
  210.   xbyte1:=xbyte1 and 7;
  211.   Port[$388]:=xbyte2;
  212.   Port[$389]:=xbyte3;
  213.   yesorno(xbyte1 = 6);
  214.   if xbyte1 = 6 then
  215.     begin
  216.     caption3('  driver');
  217.     with regs do
  218.       begin
  219.       AX:=$3565;
  220.       MsDos(regs);
  221.       s:='';
  222.       for xword:=(BX - $16) to (BX - 4) do
  223.         s:=s + Chr(Mem[ES:xword]);
  224.       if s = 'SOUND-DRIVER-AD-LIB' then
  225.         begin
  226.         Write('yes');
  227.         caption3('version');
  228.         Writeln(unBCD(Mem[ES:BX - $17]), decimal, addzero(unBCD(Mem[ES:BX - $18])));
  229.         caption3('  address');
  230.         Writeln(hex(ES, 4), ':', hex(BX, 4));
  231.         end
  232.       else
  233.         Writeln('no');
  234.       end
  235.     end;
  236.   caption3('Sound Blaster');
  237.   sbfound:=false;
  238.   xbyte1:=1;
  239.   while (xbyte1 < 7) and (not sbfound) do
  240.     begin
  241.     sbport:=$200 + ($10 * xbyte1);
  242.     xword1:=0;
  243.     portok:=false;
  244.     xword2:=sbport + $0C;
  245.     while (xword1 < $201) and (not portok) do
  246.       begin
  247.       if (Port[xword2] and $80) = 0 then
  248.         portok:=true;
  249.       Inc(xword1)
  250.       end;
  251.     if portok then
  252.       begin
  253.       xbyte3:=Port[xword2];
  254.       Port[xword2]:=$D3;
  255.       for xword2:=1 to $1000 do {nothing};
  256.       xword2:=sbport + 6;
  257.       Port[xword2]:=1;
  258.       xbyte2:=Port[xword2];
  259.       xbyte2:=Port[xword2];
  260.       xbyte2:=Port[xword2];
  261.       xbyte2:=Port[xword2];
  262.       Port[xword2]:=0;
  263.       xword2:=sbport + $0E;
  264.       xbyte2:=0;
  265.       repeat
  266.         xword1:=0;
  267.         portok:=false;
  268.         while (xword1 < $201) and (not portok) do
  269.           begin
  270.           if (Port[xword2] and $80) = $80 then
  271.             portok:=true;
  272.           Inc(xword1)
  273.           end;
  274.         if portok then
  275.           if Port[sbport + $0A] = $AA then
  276.             sbfound:=true;
  277.         Inc(xbyte2);
  278.       until (xbyte2 = $10) or (portok);
  279.       Port[xword2]:=xbyte3;
  280.       end;
  281.     if sbfound then
  282.       Writeln('yes, on port $', hex(sbport, 3))
  283.     else
  284.       Inc(xbyte1);
  285.     end;
  286.   if not sbfound then
  287.     Writeln('no');
  288.   caption3('Roland MPU-401');
  289.   portok:=false;
  290.   midifound:=false;
  291.   xbyte1:=0;
  292.   repeat
  293.     if (Port[$331] and $40) = 0 then
  294.       portok:=true;
  295.     Inc(xbyte1);
  296.   until (xbyte1 = 255) or portok;
  297.   if portok then
  298.     begin
  299.     inline($FA); {CLI}
  300.     xbyte2:=Port[$331];
  301.     Port[$331]:=$FF;
  302.     portok:=false;
  303.     xbyte1:=0;
  304.     repeat
  305.       if (Port[$331] and $80) = 0 then
  306.         portok:=true;
  307.       Inc(xbyte1);
  308.     until (xbyte1 = 255) or portok;
  309.     xbyte1:=Port[$330];
  310.     inline($FB); {STI}
  311.     if portok and (xbyte1 = $FE) then
  312.       midifound:=true
  313.     else
  314.       Port[$331]:=xbyte2;
  315.     end;
  316.   yesorno(midifound);
  317. {
  318.   caption3('Tandy digital');
  319.   with regs do
  320.     begin
  321.     AX:=$8100;
  322.     Intr($1A, regs);
  323.     yesorno(AH > $80);
  324.     end;
  325. }
  326.   end;
  327. end.
  328.